import Data.Array (Array(..), (!), bounds, elems, indices,ixmap, listArray)

import Control.Applicative ((<$>))
import Control.Monad (forM_)
import Data.Char (digitToInt)
import Data.Ix (Ix(..))
import Data.List (foldl', group, sort, sortBy, tails)
import Data.Maybe (catMaybes, listToMaybe)
import Data.Ratio (Ratio)
import Data.Word (Word8)
import System.Environment (getArgs)
import qualified Data.ByteString.Lazy.Char8 as L
import qualified Data.Map as M
--import Prelude as P

--import Parse                    -- from chapter 11



checkDigit :: (Integral a) => [a] -> a
checkDigit ds = productSum `mod` 10 `mod` 10
    where productSum = sum (mapEveryOther (*3) (reverse ds))

--($)，  (*3) $ 3 = 9  
mapEveryOther :: (a -> a) -> [a] -> [a]
mapEveryOther f = zipWith ($) (cycle [f,id])


mapEveryOther2:: (a -> a) -> [a] -> [a]
mapEveryOther2 f = zipWith ($) (cycle [f])


mapEveryOther3:: (a -> a) -> [a] -> [a]
mapEveryOther3 f = zipWith ($) ([f])


mapEveryOther4 :: (a -> a) -> [a] -> [a]
mapEveryOther4 f = zipWith ($) ([f,id])

leftOddList = ["0001101", "0011001", "0010011", "0111101", "0100011",
               "0110001", "0101111", "0111011", "0110111", "0001011"]

               
complement1 '0' = '1'
complement1 '1' = '0'      
         
--leftOddList 是 char  的双重列表 
rightList = map complement <$> leftOddList
    where complement '0' = '1'
          complement '1' = '0'

leftEvenList = map reverse rightList

parityList = ["111111", "110100", "110010", "110001", "101100", "100110", "100011", "101010", "101001", "100101"]

{-
*Main> listArray (0,2) "10110"
array (0,2) [(0,'1'),(1,'0'),(2,'1')]
*Main>
-}
listToArray :: [a] -> Array Int a
listToArray xs = listArray (0,l-1) xs
    where l = length xs

leftOddCodes, leftEvenCodes, rightCodes, parityCodes :: Array Int String

leftOddCodes = listToArray leftOddList
leftEvenCodes = listToArray leftEvenList
rightCodes = listToArray rightList
parityCodes = listToArray parityList

{-
*Main> leftOddList
["0001101","0011001","0010011","0111101","0100011","0110001","0101111","0111011","0110111","0001011"]

*Main> leftEvenList
["0100111","0110011","0011011","0100001","0011101","0111001","0000101","0010001","0001001","0010111"]

*Main> rightList
["1110010","1100110","1101100","1000010","1011100",
"1001110","1010000","1000100","1001000","1110100"]


*Main> parityList
["111111","110100","110010","110001","101100","100110","100011","101010","101001","100101"]
*Main>
-}
    
{-
*Main> indices a
[0,1,2]
*Main> a
array (0,2) [(0,'1'),(1,'0'),(2,'1')]
*Main> 
-}
foldA :: Ix k => (a -> b -> a) -> a -> Array k b -> a
foldA f s a = go s (indices a)
    where go s (j:js) = let s' = f s (a ! j)
                        in s' `seq` go s' js
          go s _ = s

-- | Strict left fold using the first element of the array as its
-- starting value, similar to foldl1 on lists.
foldA1 :: Ix k => (a -> a -> a) -> Array k a -> a
foldA1 f a = foldA f (a ! fst (bounds a)) a

encodeEAN13 :: String -> String
encodeEAN13 = concat . encodeDigits . map digitToInt

-- | This function computes the check digit; don't pass one in.
encodeDigits :: [Int] -> [String]
encodeDigits s@(first:rest) =
    outerGuard : lefties ++ centerGuard : righties ++ [outerGuard]
    where (left, right) = splitAt 6 rest
          lefties = zipWith leftEncode (parityCodes ! first) left
          righties = map rightEncode (right ++ [checkDigit s])

leftEncode :: Char -> Int -> String
leftEncode '1' = (leftOddCodes !)
leftEncode '0' = (leftEvenCodes !)

rightEncode :: Int -> String
rightEncode = (rightCodes !)

outerGuard = "101"
centerGuard = "01010"

{-

*Main> zipWith leftEncode "110100" [1,1,1,1,1,1]
["0011001","0011001","0110011","0011001","0110011","0110011"]
*Main>




 first:rest = a2
*Main> first
1
*Main> rest
[1,1,1,1,1,1,1,1,1,1,1]
*Main> (left, right) = splitAt 6 rest
*Main> left
[1,1,1,1,1,1]
*Main> right
[1,1,1,1,1]
*Main> map rightEncode (right ++ [checkDigit s])

*Main> zipWith leftEncode (parityCodes ! first) left
["0011001","0011001","0110011","0011001","0110011","0110011"]

*Main> map rightEncode (right ++ [checkDigit a2])
["1100110","1100110","1100110","1100110","1100110","1011100"]
"101  001100100110010110011001100101100110110011   01010   110011011001101100110110011011001101011100   101"
1100110
1100110
1100110
1100110
1100110
1011100
*Main>
-}


type Run = Int
type RunLength a = [(Run, a)]

runLength :: Eq a => [a] -> RunLength a
runLength = map rle . group
    where rle xs = (length xs, head xs)
    
runLengths :: Eq a => [a] -> [Run]
runLengths = map fst . runLength    


data Bit = Zero | One
           deriving (Eq, Show)

threshold :: (Ix k, Integral a) => Double -> Array k a -> Array k Bit
threshold n a = binary <$> a
    where binary i | i < pivot  = Zero
                    | otherwise  = One
          pivot    = round $ least + (greatest - least) * n
          least    = fromIntegral $ choose (<) a
          greatest = fromIntegral $ choose (>) a
          choose f = foldA1 $ \x y -> if f x y then x else y
          
type Score = Ratio Int

scaleToOne :: [Run] -> [Score]
scaleToOne xs = map divide xs
    where divide d = fromIntegral d / divisor
          divisor = fromIntegral (sum xs)
          
          
scaleToOne2 :: [Run] -> [Score]
scaleToOne2 xs = map divide xs
    where divide d = fromIntegral d / divisor
          divisor = fromIntegral (sum xs)          
-- A more compact alternative that "knows" we're using Ratio Int:
-- scaleToOne xs = map (% sum xs) xs
scale1::Int->Score
scale1 x = fromIntegral x /  (fromIntegral 5)

scale2 x = fromIntegral x /  (fromIntegral 5)
type ScoreTable = [[Score]]

-- "SRL" means "scaled run length".
asSRL :: [String] -> ScoreTable
asSRL = map (scaleToOne . runLengths)

leftOddSRL = asSRL leftOddList
leftEvenSRL = asSRL leftEvenList
rightSRL = asSRL rightList
paritySRL = asSRL parityList



distance xs1 xs2 = sum . fmap abs $  zipWith (-) xs1 xs2

type Digit1 = Int
bestScores :: ScoreTable -> [Run] -> [(Score, Digit1)]
bestScores srl ps = take 3 . sort $ scores
    where scores = zip [distance d (scaleToOne ps) | d <- srl] digits
          digits = [0..9]
          
    
-- *******************************test***********************************************

add a b = a * 10 + b
a = listArray (0,4)[1,2,3,4,5,6]
bits = [1,1,0,0,1,1,0,0,1,1,1,1,1,1,0,0,1,1,1,1]
b = runLengths bits

g1 = scaleToOne [2,6,4,4]
ga =  (head leftEvenSRL)
gb =   (head leftOddSRL)
g4 = map (1/) g1
g5 = foldl max 0 g4
ga4 = map (1/) ga
ga5 = foldl max 0 ga4
multiple1 = g5 * ga5
g6 = map (*multiple1) g1
ga6 = map (*multiple1) ga

--bestScores  leftEvenSRL  [1,1,1,0,1,0,0]
--testfun1 Ratio a = a

{-
mapEveryOther (*3) [1,1,1,1]

zipWith ($)  [(*3),id] [1,1,1,1]

mapEveryOther :: (a -> a) -> [a] -> [a]
mapEveryOther f = zipWith ($) (cycle [f,id])

d = fmap (+) [1,2,3]
zipWith ($) d [10,10,10]

 zipWith ($) ((-) <$> [1,2,3]) [10,10,10]
 
zipWith (+) [1,1,1,1]  [2,3,4,5]
[3,4,5,6]


g4 = map (1/) g1
*Main> g4
[8 % 1,8 % 3,4 % 1,4 % 1]
*Main> g5 = foldl max 0 g4
*Main> g5
8 % 1
 ga4 = map (1/) ga

foldl max 0 [1,2,3]

*Main> g1
[1 % 8,3 % 8,1 % 4,1 % 4]
*Main> ga
[1 % 7,1 % 7,2 % 7,3 % 7]
*Main>

*Main> sum $ fmap abs $  zipWith (-) g1 ga
13 % 28
*Main> sum . fmap abs $  zipWith (-) g1 ga
13 % 28
*Main>

-}
-- *********************************************************************************

         
data Parity a = Even a | Odd a | None a
                deriving (Show)

fromParity :: Parity a -> a
fromParity (Even a) = a
fromParity (Odd a) = a
fromParity (None a) = a

parityMap :: (a -> b) -> Parity a -> Parity b
parityMap f (Even a) = Even (f a)
parityMap f (Odd a) = Odd (f a)
parityMap f (None a) = None (f a)

instance Functor Parity where
    fmap = parityMap          
          
on :: (a -> a -> b) -> (c -> a) -> c -> c -> b
on f g x y = g x `f` g y

compareWithoutParity = compare `on` fromParity


type Digit = Int

bestLeft :: [Run] -> [Parity (Score, Digit)]
bestLeft ps = sortBy compareWithoutParity
          ((map Odd (bestScores leftOddSRL ps)) ++
            (map Even (bestScores leftEvenSRL ps)))

bestRight :: [Run] -> [Parity (Score, Digit)]
bestRight = map None . bestScores rightSRL     



             
--根据某种条件，分割列表；该条件是灵活可变的，可以是数量，可以是数值。             
chunkWith :: ([a] -> ([a], [a])) -> [a] -> [[a]]
chunkWith _ [] = []
chunkWith f xs = let (h, t) = f xs
             in h : chunkWith f t

--chunkWith的特化版，根据数量分割
chunksOf :: Int -> [a] -> [[a]]
chunksOf n = chunkWith (splitAt n)

{-
*Main> take 24 . drop 3 $ b
[2,2,2,1,2,2,2,1,1,2,2,2,2,2,2,1,1,2,2,2,1,2,2,2]

*Main> b1 = take 24 . drop 3 $ b

*Main> chunksOf 2 b1
[[2,2],[2,1],[2,2],[2,1],[1,2],[2,2],[2,2],[2,1],[1,2],[2,2],[1,2],[2,2]]

*Main> splitAt 4 b1
([2,2,2,1],[2,2,2,1,1,2,2,2,2,2,2,1,1,2,2,2,1,2,2,2])
*Main>
-}

candidateDigits :: RunLength Bit -> [[Parity Digit]]
candidateDigits ((_, One):_) = []
candidateDigits rle | length rle < 59 = []
candidateDigits rle
    | any null match = []
    | otherwise      = map (map (fmap snd)) match
  where match = map bestLeft left ++ map bestRight right
        left = chunksOf 4 . take 24 . drop 3 $ runLengths
        right = chunksOf 4 . take 24 . drop 32 $ runLengths
        runLengths = map fst rle
      
        
toBit 0 = Zero
toBit _ = One        
chrToBit '0' = Zero
chrToBit _ = One

--testcode1 = "101" ++ "102" ++ "10101" +  "" ++ "101"
--rle1 = [One One Zero Zero One One Zero  One One Zero Zero One One Zero One One Zero Zero One One Zero One One Zero Zero One One Zero One One Zero Zero One One Zero One One Zero Zero One One Zero]

bitsEnd="101"
bitsBegin="101"
bitsCenter="01010"
--bitsCenter="10101"
bits1R = "1100110"
bits6R = "1010000"
bits1L = "0001101"
bitsRight = bits1R ++ bits1R ++ bits1R ++ bits1R ++ bits1R ++ bits6R
--bitsLeft = bits1L ++ bits1L ++ bits1L ++ bits1L ++ bits1L ++ bits1L
bitsLeft = "0011001" ++ "0011001" ++ "0110011" ++ "0011001" ++ "0110011" ++ "0110011" 

bitsAll = bitsBegin ++ bitsLeft ++ bitsCenter ++ bitsRight ++ bitsEnd

aa = runLength bitsAll --aa :: RunLength Char
c =  map (fst . head) (group aa) 
--c等价于b
bb = map fst aa
right = chunksOf 4 . take 24 . drop 32  $ bb
right1= map bestRight right

left = chunksOf 4 . take 24 . drop 3 $ bb
left1 = map bestLeft left

match = left1 ++ right1
digits = map (map (fmap snd)) match

{-
*Main> digits
[[Odd 1,Odd 0,Even 1,Odd 2,Even 2,Even 4],[Odd 1,Odd 0,Even 1,Odd 2,Even 2,Even 4],[Even 1,Even 0,Odd 1,Odd 2,Even 2,Odd 4],[Odd 1,Odd 0,Even 1,Odd 2,Even 2,Even 4],[Even 1,Even 0,Odd 1,Odd 2,Even 2,Odd 4],[Even 1,Even 0,Odd 1,Odd 2,Even 2,Odd 4],[None 1,None 0,None 2],[None 1,None 0,None 2],[None 1,None 0,None 2],[None 1,None 0,None 2],[None 1,None 0,None 2],[None 6,None 8,None 2]]

runLengths 是【int】,长度为59
*Main>  map bestRight right

[
[None (0 % 1,1),None (2 % 7,0),None (2 % 7,2)],
[None (0 % 1,1),None (2 % 7,0),None (2 % 7,2)],
[None (0 % 1,1),None (2 % 7,0),None (2 % 7,2)],
[None (0 % 1,1),None (2 % 7,0),None (2 % 7,2)],
[None (0 % 1,1),None (2 % 7,0),None (2 % 7,2)],
[None (0 % 1,6),None (2 % 7,8),None (4 % 7,2)]
]


[[Odd (0 % 1,1),Odd (2 % 7,0),Even (2 % 7,1),Odd (2 % 7,2),Even (2 % 7,2),Even (2 % 7,4)]
[Odd (0 % 1,1),Odd (2 % 7,0),Even (2 % 7,1),Odd (2 % 7,2),Even (2 % 7,2),Even (2 % 7,4)],
[Even (0 % 1,1),Even (2 % 7,0),Odd (2 % 7,1),Odd (2 % 7,2),Even (2 % 7,2),Odd (2 % 7,4)],
[Odd (0 % 1,1),Odd (2 % 7,0),Even (2 % 7,1),Odd (2 % 7,2),Even (2 % 7,2),Even (2 % 7,4)],
[Even (0 % 1,1),Even (2 % 7,0),Odd (2 % 7,1),Odd (2 % 7,2),Even (2 % 7,2),Odd (2 % 7,4)],
[Even (0 % 1,1),Even (2 % 7,0),Odd (2 % 7,1),Odd (2 % 7,2),Even (2 % 7,2),Odd (2 % 7,4)]]

*Main> right
-}  



--rle
{-

[译注：代码中的59表示条形码中的条纹数，它是这样求出的：
3(左侧保护序列101)+4x6(每个数字的条纹数目4x左侧分组的数字数)
+5(两个分组中间的保护序列10101)+4x6(同左分组)+3(右侧保护序列) = 59。]

leftOddSRL = asSRL leftOddList
leftEvenSRL = asSRL leftEvenList
rightSRL = asSRL rightList
paritySRL = asSRL parityList

 bestScores leftOddSRL [2,6,4,4]
 
*Main> bestScores leftOddSRL [2,6,4,4]
[(3 % 14,7),(11 % 28,1),(11 % 28,5)]
*Main> bestScores leftEvenSRL [2,6,4,4]
[(5 % 28,1),(3 % 14,5),(11 % 28,2)]

*Main> bestScores rightSRL [2,6,4,4]
[(3 % 14,7),(11 % 28,1),(11 % 28,5)]
*Main> bestScores paritySRL [2,6,4,4]
[(1 % 4,5),(1 % 4,6),(1 % 4,9)]


*Main> bestLeft [2,6,4,4]
[Even (5 % 28,1),Even (3 % 14,5),Odd (3 % 14,7),Odd (11 % 28,1),Even (11 % 28,2),Odd (11 % 28,5)]
*Main>
*Main>
*Main> bestRight [2,6,4,4]
[None (3 % 14,7),None (11 % 28,1),None (11 % 28,5)]
*Main>

ps = [2,6,4,4]
a1 = map Even (bestScores leftEvenSRL ps)
a2 = map Odd (bestScores leftOddSRL ps)
a3 = a1 ++ a2
b1 = head a3
b2 = last a3
on compare  fromParity b1 b2 

*Main> fromParity b1  `compare` fromParity b2
LT
*Main> compare (fromParity b1) ( fromParity b2)
LT
*Main>

*Main> a1 = map Even (bestScores leftEvenSRL ps)
*Main> a2 = map Odd (bestScores leftOddSRL ps)
 a3 = a1 ++ a2
*Main> a3
[Even (5 % 28,1),Even (3 % 14,5),Even (11 % 28,2),Odd (3 % 14,7),Odd (11 % 28,1),Odd (11 % 28,5)]
*Main> b1 = head a3
*Main> b2 = last a3
*Main> b1
Even (5 % 28,1)
*Main> b2
Odd (11 % 28,5)

*Main> on compare  fromParity b1 b2
LT


   
          
          
     -}     
          
          
    
{-
*Main> old =  (single 1)
*Main> new =  M.empty
*Main> digit = (Even 1)
*Main> new `M.union` M.foldWithKey (updateMap digit) M.empty old
fromList [(2,[Even 1,Even 1])]

*Main>new `M.union` M.foldWithKey (updateMap digit) M.empty old


*Main>useDigit (single 1) (single 2) (Even 2)
fromList [(2,[Even 2]),(3,[Even 2,Even 1])]

*Main> (single 1)
fromList [(1,[Even 1])]

*Main>a1 =M.foldWithKey (updateMap (Even 2)) M.empty (single 1) 
fromList [(3,[Even 2,Even 1])]

*Main> (updateMap (Even 2)) 1 [Even 1]  M.empty
fromList [(3,[Even 2,Even 1])]

*Main> insertMap 1 2 [(Even 2), (Even 1)] M.empty
fromList [(3,[Even 2,Even 1])]
*Main>

*Main> useDigit (single 4) (single 2) (Even 2)
fromList [(2,[Even 2]),(6,[Even 2,Even 4])]
*Main>
*Main> useDigit (single 4) (single 2) (Even 9)
fromList [(2,[Even 2]),(3,[Even 9,Even 4])]
*Main>

*Main> incorporateDigits  (single 1)  [Even 2, Even 3]
fromList [(3,[Even 2,Even 1]),(4,[Even 3,Even 1])]
*Main>

*Main> useDigit (single 1) M.empty (Even 3)
fromList [(4,[Even 3,Even 1])]
*Main> useDigit (single 1) M.empty (Even 2)
fromList [(3,[Even 2,Even 1])]
*Main>


-}


type Map a = M.Map Digit [a]
type DigitMap = Map Digit
type ParityMap = Map (Parity Digit)

updateMap :: Parity Digit       -- ^ new digit
          -> Digit              -- ^ existing key
          -> [Parity Digit]     -- ^ existing digit sequence
          -> ParityMap          -- ^ map to update
          -> ParityMap
updateMap digit key seq = insertMap key (fromParity digit) (digit:seq)
 
insertMap :: Digit -> Digit -> [a] -> Map a -> Map a
insertMap key digit val m = val `seq` M.insert key' val m
    where key' = (key + digit) `mod` 10

useDigit :: ParityMap -> ParityMap -> Parity Digit -> ParityMap
useDigit old new digit =
    new `M.union` M.foldWithKey (updateMap digit) M.empty old   
    
-- old =  (M.singleton 0 [])
-- digit=   Odd 3,Odd 0,Even 3,Odd 6,Even 6,Even 12
    --new = M.empty,  [(3,[Odd 3,Odd 0])],
incorporateDigits :: ParityMap -> [Parity Digit] -> ParityMap
incorporateDigits old digits = foldl' (useDigit old) M.empty digits

finalDigits :: [[Parity Digit]] -> ParityMap
finalDigits = foldl' incorporateDigits (M.singleton 0 [])
            . mapEveryOther (map (fmap (*3)))  
e1 = incorporateDigits (M.singleton 0 [])   [Odd 3,Odd 0,Even 3,Odd 6,Even 6,Even 12]  
-- *Main> e1
--fromList [(0,[Odd 0]),(2,[Even 12]),(3,[Odd 3]),(6,[Odd 6])]  
e2 = incorporateDigits e1   [Odd 1,Odd 0,Even 1,Odd 2,Even 2,Even 4]
--[(0,[Odd 0,Odd 0]),(1,[Odd 1,Odd 0]),(2,[Odd 0,Even 12]),(3,[Odd 1,Even 12]),(4,[Odd 1,Odd 3]),(5,[Odd 2,Odd 3]),(6,[Odd 0,Odd 6]),(7,[Odd 1,Odd 6]),(8,[Odd 2,Odd 6])]
e3 = incorporateDigits  e2   [Odd 3,Odd 0,Even 3,Odd 6,Even 6,Even 12]    
e4 = incorporateDigits e3   [Even 3,Even 0,Odd 3,Odd 6,Even 6,Odd 12]
e5 = incorporateDigits e4   [Odd 1,Odd 0,Even 1,Odd 2,Even 2,Even 4]
e6 = incorporateDigits e5  [Even 3,Even 0,Odd 3,Odd 6,Even 6,Odd 12]
e7 = incorporateDigits e6   [Even 1,Even 0,Odd 1,Odd 2,Even 2,Odd 4]
e8 = incorporateDigits e7  [None 3,None 0,None 6]
e9 = incorporateDigits e8   [None 1,None 0,None 2]
e10 = incorporateDigits e9 [None 3,None 0,None 6]
e11 = incorporateDigits e10  [None 1,None 0,None 2]
e12 = incorporateDigits e11  [None 3,None 0,None 6]


f11 = useDigit (M.singleton 0 [])   M.empty  (Odd 3)
--[(3,[Odd 3])]W
f12 =  useDigit (M.singleton 0 []) f11 (Odd 0)
-- [(0,[Odd 0]),(3,[Odd 3])]
f13 =  useDigit (M.singleton 0 []) f12 (Even 3)
-- [(0,[Odd 0]),(3,[Odd 3])]
f14 =  useDigit (M.singleton 0 []) f13 (Odd 6)
f15 =  useDigit (M.singleton 0 []) f14 (Even 6)
f16 =  useDigit (M.singleton 0 []) f15 (Even 12)
--fromList [(0,[Odd 0]),(2,[Even 12]),(3,[Odd 3]),(6,[Odd 6])]  

f21 = useDigit f16 M.empty (Odd 1)
--useDigit    [(0,[Odd 0]),(2,[Even 12]),(3,[Odd 3]),(6,[Odd 6])]          M.empty  (Odd 1)
--fromList [(1,[Odd 1,Odd 0]),(3,[Odd 1,Even 12]),(4,[Odd 1,Odd 3]),(7,[Odd 1,Odd 6])]
f22 = useDigit f16 f21 (Odd 0)
--useDigit  [(0,[Odd 0]),(2,[Even 12]),(3,[Odd 3]),(6,[Odd 6])]      [(1,[Odd 1,Odd 0]),(3,[Odd 1,Even 12]),(4,[Odd 1,Odd 3]),(7,[Odd 1,Odd 6])]            (Odd 0 )
--fromList [(0,[Odd 0,Odd 0]),(1,[Odd 1,Odd 0]),(2,[Odd 0,Even 12]),(3,[Odd 1,Even 12]),(4,[Odd 1,Odd 3]),(6,[Odd 0,Odd 6]),(7,[Odd 1,Odd 6])]
f23 = useDigit f16 f22 (Even 1)
f24 = useDigit f16 f23 (Odd 2)
f25 = useDigit f16 f24 (Even 2)
f26 = useDigit f16 f25 (Even 4)

--useDigit    [(0,[Odd 0]),(2,[Even 12]),(3,[Odd 3]),(6,[Odd 6])]          M.empty  (Odd 1)
f210 = useDigit f16 M.empty (Odd 1)
--fromList [(1,[Odd 1,Odd 0]),(3,[Odd 1,Even 12]),(4,[Odd 1,Odd 3]),(7,[Odd 1,Odd 6])]
f220 = useDigit f16 M.empty (Odd 0)
--fromList [(0,[Odd 0,Odd 0]),(2,[Odd 0,Even 12]),(3,[Odd 0,Odd 3]),(6,[Odd 0,Odd 6])]
f230 = useDigit f16 M.empty (Even 1)
--fromList [(1,[Even 1,Odd 0]),(3,[Even 1,Even 12]),(4,[Even 1,Odd 3]),(7,[Even 1,Odd 6])]
f240 = useDigit f16 M.empty (Odd 2)
f250 = useDigit f16 M.empty (Even 2)
f260 = useDigit f16 M.empty (Even 4)

--fromList [(0,[Odd 0,Odd 0]),(1,[Odd 1,Odd 0]),(2,[Odd 0,Even 12]),(3,[Odd 1,Even 12]),(4,[Odd 1,Odd 3]),(5,[Odd 2,Odd 3]),(6,[Odd 0,Odd 6]),(7,[Odd 1,Odd 6]),(8,[Odd 2,Odd 6])]
{-
*Main> f1 = useDigit (M.singleton 0 [])   M.empty  (Odd 3)
*Main> f1
fromList [(3,[Odd 3])]
*Main> f2 =  useDigit (M.singleton 0 []) f1 (Odd 0)
*Main> f2
fromList [(0,[Odd 0]),(3,[Odd 3])]
*Main> f3 =  useDigit (M.singleton 0 []) f2 (Even 3)
*Main> f3
fromList [(0,[Odd 0]),(3,[Odd 3])]
*Main>



*Main>
[
[Odd 1,Odd 0,Even 1,Odd 2,Even 2,Even 4],
[Odd 1,Odd 0,Even 1,Odd 2,Even 2,Even 4],
[Even 1,Even 0,Odd 1,Odd 2,Even 2,Odd 4],
[Odd 1,Odd 0,Even 1,Odd 2,Even 2,Even 4],
[Even 1,Even 0,Odd 1,Odd 2,Even 2,Odd 4],
[Even 1,Even 0,Odd 1,Odd 2,Even 2,Odd 4],

[None 1,None 0,None 2],
[None 1,None 0,None 2],
[None 1,None 0,None 2],
[None 1,None 0,None 2],
[None 1,None 0,None 2],
[None 6,None 8,None 2]
]

*Main> mapEveryOther (map (fmap (*3))) (init digits)
[
[Odd 3,Odd 0,Even 3,Odd 6,Even 6,Even 12],
[Odd 1,Odd 0,Even 1,Odd 2,Even 2,Even 4],
[Even 3,Even 0,Odd 3,Odd 6,Even 6,Odd 12],
[Odd 1,Odd 0,Even 1,Odd 2,Even 2,Even 4],

[Even 3,Even 0,Odd 3,Odd 6,Even 6,Odd 12],
[Even 1,Even 0,Odd 1,Odd 2,Even 2,Odd 4],

[None 3,None 0,None 6],
[None 1,None 0,None 2],
[None 3,None 0,None 6],
[None 1,None 0,None 2],
[None 3,None 0,None 6]]


fromList [
(0,[None 3,None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 3,Odd 3,Odd 2,Odd 6]),
(1,[None 3,None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 3,Odd 0,Odd 0,Even 12]),
(2,[None 3,None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 3,Odd 3,Odd 0,Odd 0]),
(3,[None 3,None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 3,Odd 3,Odd 1,Odd 0]),
(4,[None 3,None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 3,Odd 3,Odd 0,Even 12]),
(5,[None 3,None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 3,Odd 3,Odd 1,Even 12]),(6,[None 3,None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 3,Odd 3,Odd 1,Odd 3]),(7,[None 3,None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 3,Odd 3,Odd 2,Odd 3]),(8,[None 3,None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 3,Odd 3,Odd 0,Odd 6]),(9,[None 3,None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 3,Odd 3,Odd 1,Odd 6])]

*Main> e11
fromList [
(0,[None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 3,Odd 3,Odd 1,Odd 0]),
(1,[None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 3,Odd 3,Odd 0,Even 12]),(2,[None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 3,Odd 3,Odd 1,Even 12]),(3,[None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 3,Odd 3,Odd 1,Odd 3]),(4,[None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 3,Odd 3,Odd 2,Odd 3]),(5,[None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 3,Odd 3,Odd 0,Odd 6]),(6,[None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 3,Odd 3,Odd 1,Odd 6]),(7,[None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 3,Odd 3,Odd 2,Odd 6]),(8,[None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 3,Odd 0,Odd 0,Even 12]),(9,[None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 3,Odd 3,Odd 0,Odd 0])]

*Main> dd1 = finalDigits (init digits)
*Main>dd1
fromList [
(0,[None 3,None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 3,Odd 1,Odd 0]),
(1,[None 3,None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 3,Odd 0,Even 12]),
(2,[None 3,None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 3,Odd 1,Even 12]),
(3,[None 3,None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 3,Odd 1,Odd 3]),
(4,[None 3,None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 3,Odd 2,Odd 3]),
(5,[None 3,None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 3,Odd 0,Odd 6]),
(6,[None 3,None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 3,Odd 1,Odd 6]),
(7,[None 3,None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 3,Odd 2,Odd 6]),
(8,[None 3,None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 0,Odd 0,Even 12]),
(9,[None 3,None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 3,Odd 0,Odd 0])]
//11个
-}
    
    
-- file: ch12/Barcode.hs
firstDigit :: [Parity a] -> Digit
firstDigit = snd
           . head
           . bestScores paritySRL
           . runLengths
           . map parityBit
           . take 6
  where parityBit (Even _) = Zero
        parityBit (Odd _) = One

addFirstDigit :: ParityMap -> DigitMap
addFirstDigit = M.foldWithKey updateFirst M.empty

updateFirst :: Digit -> [Parity Digit] -> DigitMap -> DigitMap
updateFirst key seq = insertMap key digit (digit:renormalize qes)
  where renormalize = mapEveryOther (`div` 3) . map fromParity
        digit = firstDigit qes
        qes = reverse seq

buildMap :: [[Parity Digit]] -> DigitMap
buildMap = M.mapKeys (realCheckDigit)
         . addFirstDigit
         . finalDigits
        where realCheckDigit c = (10 - c) `mod` 10   




        
realCheckDigit c = (10 - c) `mod` 10  
dd1 = finalDigits (init digits)
dd2 = addFirstDigit dd1
dd3 = M.mapKeys (realCheckDigit) dd2
{-

*Main>

[
[Odd 1,Odd 0,Even 1,Odd 2,Even 2,Even 4],
[Odd 1,Odd 0,Even 1,Odd 2,Even 2,Even 4],
[Even 1,Even 0,Odd 1,Odd 2,Even 2,Odd 4],
[Odd 1,Odd 0,Even 1,Odd 2,Even 2,Even 4],
[Even 1,Even 0,Odd 1,Odd 2,Even 2,Odd 4],
[Even 1,Even 0,Odd 1,Odd 2,Even 2,Odd 4],

[None 1,None 0,None 2],
[None 1,None 0,None 2],
[None 1,None 0,None 2],
[None 1,None 0,None 2],
[None 1,None 0,None 2],
[None 6,None 8,None 2]
]

*Main> mapEveryOther (map (fmap (*3))) (init digits)
[
[Odd 3,Odd 0,Even 3,Odd 6,Even 6,Even 12],
[Odd 1,Odd 0,Even 1,Odd 2,Even 2,Even 4],
[Even 3,Even 0,Odd 3,Odd 6,Even 6,Odd 12],
[Odd 1,Odd 0,Even 1,Odd 2,Even 2,Even 4],
[Even 3,Even 0,Odd 3,Odd 6,Even 6,Odd 12],
[Even 1,Even 0,Odd 1,Odd 2,Even 2,Odd 4],

[None 3,None 0,None 6],
[None 1,None 0,None 2],
[None 3,None 0,None 6],
[None 1,None 0,None 2],
[None 3,None 0,None 6]]


*Main> dd1 = finalDigits (init digits)
*Main>dd1
fromList [
(0,[None 3,None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 3,Odd 1,Odd 0]),
(1,[None 3,None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 3,Odd 0,Even 12]),
(2,[None 3,None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 3,Odd 1,Even 12]),
(3,[None 3,None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 3,Odd 1,Odd 3]),
(4,[None 3,None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 3,Odd 2,Odd 3]),
(5,[None 3,None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 3,Odd 0,Odd 6]),
(6,[None 3,None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 3,Odd 1,Odd 6]),
(7,[None 3,None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 3,Odd 2,Odd 6]),
(8,[None 3,None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 0,Odd 0,Even 12]),
(9,[None 3,None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 3,Odd 0,Odd 0])]
//11个

*Main> updateFirst 0  [None 3,None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 3,Odd 1,Odd 0]  M.empty
fromList [(1,[1,0,1,1,1,1,1,1,1,1,1,1])]
*Main> updateFirst 2 [None 3,None 1,None 3,None 1,None 3,Even 1,Even 3,Odd 1,Even 3,Odd 1,Even 12] M.empty
fromList [(9,[7,4,1,1,1,1,1,1,1,1,1,1])]

*Main> dd2 = addFirstDigit dd1
*Main> dd2
fromList [
(0,[1,0,0,1,1,1,1,1,1,1,1,1]),
(1,[1,0,1,1,1,1,1,1,1,1,1,1]),
(4,[1,1,1,1,1,1,1,1,1,1,1,1]),
(5,[1,1,2,1,1,1,1,1,1,1,1,1]),
(6,[1,2,0,1,1,1,1,1,1,1,1,1]),
(7,[1,2,1,1,1,1,1,1,1,1,1,1]),
(8,[7,4,0,1,1,1,1,1,1,1,1,1]),
(9,[7,4,1,1,1,1,1,1,1,1,1,1])]
//12个
*Main>
*Main> dd3 = M.mapKeys (realCheckDigit) dd2
fromList [
(0,[1,0,0,1,1,1,1,1,1,1,1,1]),
(1,[7,4,1,1,1,1,1,1,1,1,1,1]),
(2,[7,4,0,1,1,1,1,1,1,1,1,1]),
(3,[1,2,1,1,1,1,1,1,1,1,1,1]),
(4,[1,2,0,1,1,1,1,1,1,1,1,1]),
(5,[1,1,2,1,1,1,1,1,1,1,1,1]),
(6,[1,1,1,1,1,1,1,1,1,1,1,1]),
(9,[1,0,1,1,1,1,1,1,1,1,1,1])]//12个

*Main> buildMap (init digits)
fromList [
(0,[1,0,0,1,1,1,1,1,1,1,1,1]),
(1,[7,4,1,1,1,1,1,1,1,1,1,1]),
(2,[7,4,0,1,1,1,1,1,1,1,1,1]),
(3,[1,2,1,1,1,1,1,1,1,1,1,1]),
(4,[1,2,0,1,1,1,1,1,1,1,1,1]),
(5,[1,1,2,1,1,1,1,1,1,1,1,1]),
(6,[1,1,1,1,1,1,1,1,1,1,1,1]),
(9,[1,0,1,1,1,1,1,1,1,1,1,1])]



-}            

-- file: ch12/Barcode.hs

--这个是最终版的解码，得到多个可能的结果，运气好的话，只剩下一个。
solve :: [[Parity Digit]] -> [[Digit]]
solve [] = []
solve xs = catMaybes $ map (addCheckDigit m) checkDigits
    where checkDigits = map fromParity (last xs)
          m = buildMap (init xs)
          addCheckDigit m k = (++[k]) <$> M.lookup k m
{-

*Main> solve digits
[[1,1,1,1,1,1,1,1,1,1,1,1,6],[7,4,0,1,1,1,1,1,1,1,1,1,2]]
*Main> :t digits
digits :: [[Parity Digit]]
*Main> digits
[[Odd 1,Odd 0,Even 1,Odd 2,Even 2,Even 4],
[Odd 1,Odd 0,Even 1,Odd 2,Even 2,Even 4],[Even 1,Even 0,Odd 1,Odd 2,Even 2,Odd 4],[Odd 1,Odd 0,Even 1,Odd 2,Even 2,Even 4],[Even 1,Even 0,Odd 1,Odd 2,Even 2,Odd 4],[Even 1,Even 0,Odd 1,Odd 2,Even 2,Odd 4],[None 1,None 0,None 2],[None 1,None 0,None 2],[None 1,None 0,None 2],[None 1,None 0,None 2],[None 1,None 0,None 2],[None 6,None 8,None 2]]
*Main>

*Main> checkDigits
[6,8,2]
*Main> addCheckDigit dd3 6
Just [1,1,1,1,1,1,1,1,1,1,1,1,6]
*Main>
*Main> (++[k]) <$> M.lookup k dd3
Just [1,1,1,1,1,1,1,1,1,1,1,1,6]
*Main>  M.lookup k dd3
Just [1,1,1,1,1,1,1,1,1,1,1,1]
                      
*Main> fmap  (++[12])(M.lookup 6 dd3)
Just [1,1,1,1,1,1,1,1,1,1,1,1,12]
*Main>
-}          
          
